home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zh.d64 / src.notbasic < prev    next >
Text File  |  2007-03-01  |  2KB  |  113 lines
  1. ;
  2. ;-------------------------------;
  3. ; NOTBASIC                      ;
  4. ;         A MODULE FOR COMAL    ;
  5. ;                               ;
  6. ; BY DICK KLINGENS              ;
  7. ;                               ;
  8. ; SEP85                         ;
  9. ;                               ;
  10. ; DUTCH COMAL USERS GROUP       ;
  11. ;-------------------------------;
  12. ;
  13. * =$8009; START MODULE
  14. ;
  15. ;--CONSTANTS--------------------;
  16. ;
  17. FALSE =0
  18. TRUE =1
  19. ;
  20. DEFPAG =%01000110 ; 52KB ROM MAP
  21. ;
  22. DIS =8 ; CHARACTERS
  23. CR =13
  24. LOWER =14
  25. ;
  26. ;--VARIABLES--------------------;
  27. ;
  28. TEMP =$0055 ; TEMPORARY STORAGE
  29. IND =$00FB ; POINTER FOR PRTEXT
  30. NOREST =$C841 ; NO RESTORE: TRUE=DISABLED
  31. ;
  32. ;--ROUTINES---------------------;
  33. ;
  34. CWRT =$CA06 ; WRITE CHARACTER
  35. SCAN =$FFE4 ; SCAN KEYBOARD
  36. ;
  37. ;--SIGNAL TYPES-----------------;
  38. ;
  39. DISCRD =3 ; BEFORE DISCARD-COMMAND
  40. NEW =4 ; AFTER NEW-COMMAND
  41. BASIC =11 ; BEFORE LEAVING COMAL
  42. ;
  43. ;--MODULE DESCRIPTION-----------;
  44. ;
  45.  .BYTE  DEFPAG          ; MAP
  46.        .WORD  LEND            ; END OF MODULE
  47.  .WORD  SIGNAL          ; SIGNAL ROUTINES
  48. ;
  49.  .BYTE  0               ; NO PACKAGES
  50. ;
  51. SIGNAL CPY #DISCRD ; IF DISCARD THEN
  52.  BEQ INCODE ;   GOTO INCODE
  53.  CPY #NEW ; IF NEW THEN
  54.  BEQ INCODE ;   GOTO INCODE
  55.  CPY #BASIC ; IF BASIC THEN
  56.  BEQ INCODE ;   GOTO INCODE
  57.  RTS ; COMAL
  58. ;
  59. INCODE LDA #TRUE
  60.  STA NOREST ; NOREST:=TRUE :DISABLE RESTORE
  61.  LDA #<TEXT ; .A:=LO TEXT
  62.  LDX #>TEXT ; .X:=HI TEXT
  63.  JSR PRTEXT ; EXEC PRTEXT
  64.  JSR READ ; EXEC READ
  65.  LDA #FALSE
  66.  STA NOREST ; NOREST=FALSE :ENABLE RESTORE
  67.  RTS ; COMAL
  68. ;
  69. PRTEXT STA IND ; (IND):=.A :SETUP POINTER
  70.  STX IND+1 ; (IND+1):=.X
  71.  LDY #0 ; .Y:=0
  72. REPEAT LDA (IND),Y ; READ CHAR
  73.  BEQ EOT ; IF END-OF-TEXT THEN GOTO EOT
  74.  JSR CWRT ; EXEC CWRT :PRINT CHAR
  75.  INY ; .Y:+1
  76.  BNE REPEAT
  77. EOT RTS ; RETURN
  78. ;
  79. TEXT .BYTE DIS,LOWER
  80.  .BYTE 'TYPE CODE: '
  81.  .BYTE 0 ; END-OF-TEXT
  82. ;
  83. READ LDX #0 ; .X:=0
  84. WAIT STX TEMP ; (TEMP):=.X
  85. SWAIT JSR SCAN ; EXEC SCAN :GET CHAR
  86.  BEQ SWAIT ; IF NO-CHAR THEN GOTO SWAIT
  87.  LDX TEMP ; .X:=(TEMP)
  88.  CMP CODE,X ; IF NOT CODE=X THEN
  89.  BNE CDWRNG ;   GOTO CDWRNG
  90.  INX ; .X:+1
  91.  CPX #CODEND-CODE ; IF NOT END-OF-CODE THEN
  92.  BNE WAIT ;   GOTO WAIT
  93.  LDA #<OK
  94.  LDX #>OK
  95.  JSR PRTEXT ; EXEC PRTEXT :PRINT "OK"
  96.  RTS ; RETURN
  97. ;
  98. CDWRNG JSR SCAN ; EXEC SCAN :GET CHAR
  99.  CMP #CR ; IF NOT <CR> THEN
  100.  BNE CDWRNG ;   GOTO CDWRNG
  101.  LDA #<WRNG
  102.  LDX #>WRNG
  103.  JSR PRTEXT ; : PRINT "ERROR.."
  104. LOOP JMP LOOP ; ONLY RESET WILL DO
  105. ;
  106. CODE .BYTE 'CML80' ; THIS IS THE CODE
  107. CODEND
  108. ;
  109. OK .BYTE 'OK',CR,0
  110. WRNG .BYTE 'ERROR IN CODE, RESET',CR,0
  111. ;
  112. LEND   .END
  113.